home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / texec / dexec.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-12-22  |  3.2 KB  |  141 lines
  1. unit dexec;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms;
  7.  
  8. type
  9.   Tshow=(Normal, Minimized, Maximized);
  10.  
  11.   TExec = class(TComponent)
  12.   private
  13.     Fprogname: String;
  14.     Fprogparams: String;
  15.     Fshow: Tshow;
  16.     Fwait: boolean;
  17.     Ftimeout: word;
  18.     Freturncode:integer;
  19.     Freasoncode:integer;
  20.     Finstance:integer;
  21.     Fmessage:string;
  22.   public
  23.     Constructor Create(AOwner:TComponent); override;
  24.     Destructor Destroy; override;
  25.     Procedure Exec;
  26.   published
  27.     property ProgName:String Read Fprogname Write FProgname;
  28.     property ProgParams:String Read Fprogparams Write FProgparams;
  29.     property Show:Tshow Read Fshow Write Fshow;
  30.     property Wait:Boolean Read Fwait Write Fwait;
  31.     property Timeout:word Read Ftimeout Write Ftimeout;
  32.     property Returncode:Integer Read Freturncode;
  33.     property Reasoncode:Integer Read Freasoncode;
  34.     property Instance:Integer Read FInstance;
  35.     property Message:string Read Fmessage;
  36.   end;
  37.  
  38. procedure Register;
  39.  
  40. implementation
  41.  
  42. Destructor TExec.Destroy;
  43. Begin
  44.   inherited Destroy;
  45. End;
  46.  
  47. Constructor TExec.Create(AOwner:TComponent);
  48. Begin
  49.   inherited Create(AOwner);
  50.   Fprogname:='';
  51.   Fprogparams:='';
  52.   Fshow:= Normal;
  53.   Fwait:= False;
  54.   Ftimeout:= 0;
  55.   Freturncode:=0;
  56.   Fmessage:='';
  57.   Freasoncode:=0;
  58.   Finstance:=0;
  59.  
  60. End;
  61.  
  62. Procedure Texec.Exec;
  63. var
  64. szCline: pchar;
  65. i:integer;
  66. sw:word;
  67. stime,ctime:Tdatetime;
  68. hrs,mins,secs,msecs: word;
  69. begin
  70. try
  71. Fmessage:='';
  72. Freturncode:=0;
  73. Freasoncode:=0;
  74. Finstance:=0;
  75. stime:=sysutils.time;
  76.  
  77. sw:=SW_SHOWNORMAL;
  78. case ord(Fshow)of
  79.      1:  sw:=SW_SHOWMINNOACTIVE;
  80.      2:  sw:=SW_SHOWMAXIMIZED;
  81.      end;
  82.  
  83. szcline:=allocmem(length(Fprogname)+length(Fprogparams)+1);
  84. strpcopy(szcline,Fprogname+' '+Fprogparams);
  85. i:=winexec(szcline,sw);
  86.  
  87. if i < 32 then
  88.  
  89.   begin
  90.    Freturncode:=1;
  91.    Freasoncode:=i;
  92.    Fmessage:='File Not Found';
  93.    case Freasoncode of
  94.      0:  Fmessage:='Out Of Memory';
  95.      3:  Fmessage:='Path Not Found';
  96.      5:  Fmessage:='Sharing Violation';
  97.      6:  Fmessage:='Library/Segment Error';
  98.      8:  Fmessage:='Out of Memory';
  99.      10: Fmessage:='Incorrect Windows Version';
  100.      11: Fmessage:='Invalid File';
  101.      12: Fmessage:='Incorrect DOS Version';
  102.      13: Fmessage:='Incorrect DOS Version';
  103.      14: Fmessage:='No Association for File Type';
  104.      15: Fmessage:='Incorrect Windows Version';
  105.      16: Fmessage:='Program Already Running';
  106.      19: Fmessage:='File is Compressed';
  107.      20: Fmessage:='Invalid DLL';
  108.      21: Fmessage:='Program Requires 32-bit Extensions';
  109.      end;
  110.   end
  111. else
  112.   begin
  113.      Finstance:=i;
  114.      if Fwait then
  115.         begin
  116.         while getmoduleusage(i) > 0 do
  117.            begin
  118.            application.processmessages;
  119.            decodetime (sysutils.time-stime,hrs,mins,secs,msecs);
  120.            hrs:=hrs*60+mins;
  121.            hrs:=hrs*60+secs;
  122.            if (Ftimeout > 0) and (Ftimeout < hrs) then
  123.               begin
  124.               Freturncode:=2;
  125.               break;
  126.               end;
  127.            end;
  128.         end;
  129.      end;
  130. finally
  131. freemem(szcline,length(Fprogname)+length(Fprogparams)+1);
  132. end;
  133.  
  134. End;
  135. procedure Register;
  136. begin
  137.   RegisterComponents('System', [TExec]);
  138. end;
  139.  
  140. end.
  141.